home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / SCHEME / GNU / SCM4E1 / !Scm / slib / scaoutp < prev    next >
Text File  |  1993-03-25  |  2KB  |  79 lines
  1. ;;; This file was munged by a simple minded sed script since it left
  2. ;;; its original authors' hands.  See syncase.doc for the horrid details.
  3.  
  4. ;;; output.ss
  5. ;;; Robert Hieb & Kent Dybvig
  6. ;;; 92/06/18
  7.  
  8. ; The output routines can be tailored to feed a specific system or compiler.
  9. ; They are set up here to generate the following subset of standard Scheme:
  10.  
  11. ;  <expression> :== <application>
  12. ;                |  <variable>
  13. ;                |  (set! <variable> <expression>)
  14. ;                |  (define <variable> <expression>)
  15. ;                |  (lambda (<variable>*) <expression>)
  16. ;                |  (lambda <variable> <expression>)
  17. ;                |  (lambda (<variable>+ . <variable>) <expression>)
  18. ;                |  (letrec (<binding>+) <expression>)
  19. ;                |  (if <expression> <expression> <expression>)
  20. ;                |  (begin <expression> <expression>)
  21. ;                |  (quote <datum>)
  22. ; <application> :== (<expression>+)
  23. ;     <binding> :== (<variable> <expression>)
  24. ;    <variable> :== <symbol>
  25.  
  26. ; Definitions are generated only at top level.
  27.  
  28. (define syncase:build-application
  29.    (lambda (fun-exp arg-exps)
  30.       `(,fun-exp ,@arg-exps)))
  31.  
  32. (define syncase:build-conditional
  33.    (lambda (test-exp then-exp else-exp)
  34.       `(if ,test-exp ,then-exp ,else-exp)))
  35.  
  36. (define syncase:build-lexical-reference (lambda (var) var))
  37.  
  38. (define syncase:build-lexical-assignment
  39.    (lambda (var exp)
  40.       `(set! ,var ,exp)))
  41.  
  42. (define syncase:build-global-reference (lambda (var) var))
  43.  
  44. (define syncase:build-global-assignment
  45.    (lambda (var exp)
  46.       `(set! ,var ,exp)))
  47.  
  48. (define syncase:build-lambda
  49.    (lambda (vars exp)
  50.       `(lambda ,vars ,exp)))
  51.  
  52. (define syncase:build-improper-lambda
  53.    (lambda (vars var exp)
  54.       `(lambda (,@vars . ,var) ,exp)))
  55.  
  56. (define syncase:build-data
  57.    (lambda (exp)
  58.       `(quote ,exp)))
  59.  
  60. (define syncase:build-identifier
  61.    (lambda (id)
  62.       `(quote ,id)))
  63.  
  64. (define syncase:build-sequence
  65.    (lambda (exps)
  66.       (if (null? (cdr exps))
  67.           (car exps)
  68.           `(begin ,(car exps) ,(syncase:build-sequence (cdr exps))))))
  69.  
  70. (define syncase:build-letrec
  71.    (lambda (vars val-exps body-exp)
  72.       (if (null? vars)
  73.           body-exp
  74.           `(letrec ,(map list vars val-exps) ,body-exp))))
  75.  
  76. (define syncase:build-global-definition
  77.    (lambda (var val)
  78.       `(define ,var ,val)))
  79.